home *** CD-ROM | disk | FTP | other *** search
/ Programming Languages Suite / ProgramD2.iso / Visual Database / Visual BASIC 5.0 (Ent. Edition) / Vb5ent Extractor.EXE / VB / SAMPLES / ENTRPRIS / APE / AEQUEUE / CLSQUEDL.CLS < prev    next >
Encoding:
Visual Basic class definition  |  1996-12-04  |  16.6 KB  |  340 lines

  1. VERSION 1.0 CLASS
  2. BEGIN
  3.   MultiUse = -1  'True
  4. END
  5. Attribute VB_Name = "clsQueueDelegator"
  6. Attribute VB_GlobalNameSpace = False
  7. Attribute VB_Creatable = False
  8. Attribute VB_PredeclaredId = False
  9. Attribute VB_Exposed = True
  10. Attribute VB_Description = "Provides an interface for the AEExpediter and the AEWorker to interact with the AEQueueMgr."
  11. Option Explicit
  12. '-------------------------------------------------------------------------
  13. 'The Class is public but not creatable.  It is provide as an OLE interface
  14. 'for the Expediter and Workers to call.  The Worker calls the GetServiceRequest Method
  15. 'to return Service results and retrieve a new Service Request.
  16. '-------------------------------------------------------------------------
  17.  
  18. Implements APEInterfaces.QueueDelegator
  19.  
  20.  
  21. Private Function QueueDelegator_GetServiceRequest(ByVal lWorkerID As Long, Optional ByVal lReturnServiceID As Long = 0&, Optional ByVal vReturnData As Variant, Optional ByVal sReturnError As String = "") As Variant
  22.     '-------------------------------------------------------------------------
  23.     'Purpose:   Worker should call this method to poll for a
  24.     '           Service Request to satisfy.
  25.     'IN:
  26.     '   [lWorkerID]
  27.     '           Worker's ID, it is the same as its key to the gcWorkers collection
  28.     'Optional IN:
  29.     '           The following optional parameters allow a Worker to return
  30.     '           the results of a service request at the same time it is
  31.     '           calling for a new service to accomplish.
  32.     '   [lReturnServiceID]
  33.     '           Service Request ID of Service whose results are being returned
  34.     '           Store the returned results so the Expediter can get them
  35.     '           and return them to the client application
  36.     '   [vReturnData]
  37.     '           Return data from the accomplished service or task.  Unknown
  38.     '           data type.  Just store it and Expediter will get it to pass
  39.     '           back to client application
  40.     '   [sReturnError]
  41.     '           String that contains error information that occured during
  42.     '           service competion.  Expediter will get this to pass back
  43.     '           to client application.
  44.     'Return:    Is a variant array with Service Request data if the QueueMgr
  45.     '           has a Service Request for it to satify.  Otherwise, a Null
  46.     '           is returned.  The Service ID, the Command string, UseCallback
  47.     '           flag, Data Present flag, and ServiceData are passed in the
  48.     '           returned array
  49.     'Effects:
  50.     '   [gbBusyGetServiceRequest]
  51.     '           is true during procedure
  52.     '   [gcQueue]
  53.     '           The Service Request item, a clsService class object, in the
  54.     '           collection will have its status property changed to giDELEGATED_TO_WORKER
  55.     '           if it is returned to the Worker
  56.     '           Another Service Request item in the collection whose results
  57.     '           are being returned may have it status property changed to
  58.     '           giHAVE_SERVICE_RESULTS
  59.     '   [gcWorkers]
  60.     '           An item's Busy flag that corresponds with calling Worker is
  61.     '           flipped to false if no Service Request is returned.  If a
  62.     '           Service Request is returned it is set to true.
  63.     'Assumes:
  64.     '   [gcWorkers]
  65.     '           Is a collection of valid AEWorker.Worker objects
  66.     '   [Calling Object]
  67.     '           Is a Worker in the gcWorkers collection and is passing an
  68.     '           ID that matches the key to it in the gcWorkers collection
  69.     '   [gcQueue]
  70.     '           Is a collection of clsService objects
  71.     '-------------------------------------------------------------------------
  72.     'First check to see if there is an Service request in the queue
  73.     'Pass back a variant array to the Worker if there is another Service
  74.     Dim oService As clsService  'Will be the clsService object to store the
  75.                                 'passed results in and then it will be the
  76.                                 'clsService object to retrieve Service Request
  77.                                 'Data from and pass back to worker
  78.     Dim sKeyToRemove As String  'Key of clsService object in gcQueue to remove
  79.     Dim oa As clsService        'clsService object used in For...Next loop
  80.     Dim bGotService As Boolean  'Flag meaing Service Request is chosen to pass back
  81.     Dim vServiceData(3) As Variant  'Array that will contain Service request data
  82.                                     'to be returned to Worker
  83.     Dim lCount As Long              'Count of items in gcQueue
  84.     Dim l As Long                   'For...Next counter
  85.     Dim oWork As clsWorker      'clsWorker object that contains a reference to the
  86.                                 'calling Worker object
  87.     On Error GoTo QueueDelegator_GetServiceRequestError
  88.     
  89.     gbBusyGetServiceRequest = True
  90.     
  91.     'Get the clsWorker object that contains the Worker that is calling
  92.     Set oWork = gcWorkers.Item(CStr(lWorkerID))
  93.     
  94.     'See if Service Request results were returned.  If they were
  95.     'store the Service Request results in gcQueue in the clsService
  96.     'object if the objects UseCallback property is true.  If it is
  97.     'false, ignore any results and remove item from queue now.
  98.     If (Not lReturnServiceID = 0) And (Not gbStopTest) Then
  99.         'We have a return, now see if results should be stored
  100.         'for expediter to get and return to client application
  101.         Set oService = gcQueue.Item(CStr(lReturnServiceID))
  102.         With oService
  103.             Select Case .CallBackMode
  104.                 Case giUSE_DEFAULT_CALLBACK, giUSE_PASSED_CALLBACK, giRETURN_BY_SYNC_EVENT
  105.                     'store values and change status flag
  106.                     LogEvent giGETREQUEST_RECEIVED_RETURNED_RESULTS, CLng(lReturnServiceID)
  107.                     .Status = giHAVE_SERVICE_RESULTS
  108.                     .ReturnError = sReturnError
  109.                     If Not IsMissing(vReturnData) Then
  110.                         'Check what data type vReturnData is
  111.                         'in order to determine how to handle it
  112.                         Select Case VarType(vReturnData)
  113.                             Case vbEmpty, vbNull
  114.                                 .ReturnData = Null
  115.                             Case vbObject, vbError, vbDataObject
  116.                                 Set .ReturnData = vReturnData
  117.                             Case Else
  118.                                 .ReturnData = vReturnData
  119.                         End Select
  120.                     End If
  121.                     gbHaveServiceResults = True
  122.                 Case Else
  123.                     'if a callback is not to be returned just
  124.                     'remove the clsService object from gcQueue
  125.                     gcQueue.Remove CStr(lReturnServiceID)
  126.             End Select
  127.         End With
  128.         Set oService = Nothing
  129.     End If
  130.     
  131.     'Exit sub if Stopping Queue
  132.     If gbStopTest Then
  133.         GoTo NoServiceToReturn
  134.     End If
  135.    
  136.     'See if the calling Worker is Marked for removal.  If it is
  137.     'return the integer value giCLOSE_WORKER_NOW instead of returning
  138.     'a Service request.  Also, remove the clsWorker object from
  139.     'gcWorkers so that when the local reference to it (oWork)
  140.     'goes out of scope the Worker will unload
  141.     lCount = gcQueue.Count
  142.  
  143.     If oWork.RemoveMe Then
  144.         gcWorkers.Remove CStr(lWorkerID)
  145.         'Update worker count U/I
  146.         If gbShow Then
  147.             With frmQueueMgr.lblWorkerCount
  148.                 .Caption = gcWorkers.Count
  149.                 .Refresh
  150.             End With
  151.         End If
  152.         QueueDelegator_GetServiceRequest = giCLOSE_WORKER_NOW
  153.         Exit Function
  154.     Else
  155.         If lCount > 0 Then
  156.             'Pass another Service throught the parameters passed ByRef
  157.             'It seems that this procedure or the Delegate procedure is dropped into
  158.             'using the same oService in gcQueue so Status flag is
  159.             'added so it can be flipped immediately
  160.             bGotService = False
  161.             'Use For...Next instead of For...Each to make sure that
  162.             'correct priority is given to items in the collection
  163.             For l = 1 To gcQueue.Count
  164.                 'If an item is removed during this loop by another process
  165.                 'an Invalid Procedure call error will be produced if
  166.                 'try to reference a object that no longer exists
  167.                 On Error Resume Next
  168.                 Set oa = gcQueue(l)
  169.                 If Err.Number = ERR_INVALID_PROCEDURE_CALL Then
  170.                     On Error GoTo QueueDelegator_GetServiceRequestError
  171.                     Exit For
  172.                 End If
  173.                 On Error GoTo QueueDelegator_GetServiceRequestError
  174.                 If oa.Status = giWAITING_FOR_WORKER Then
  175.                     oa.Status = giDELEGATED_TO_WORKER
  176.                     sKeyToRemove = CStr(oa.ID)
  177.                     Set oService = oa
  178.                     bGotService = True
  179.                     Exit For
  180.                 End If
  181.             Next
  182.             If Not bGotService Then
  183.                 'event though gcQueue.Count is greater than
  184.                 'zero all the items are already delgated so
  185.                 'Mark the worker as not busy and exit
  186.                 GoTo NoServiceToReturn
  187.             End If
  188.             
  189.             'Fill the variant array to be returned
  190.             With oService
  191.                 LogEvent giGETREQUEST_RECEIVED_NEW_SERVICE, .ID
  192.                 vServiceData(giSERVICE_ID_ELEMENT) = .ID
  193.                 vServiceData(giCOMMAND_ELEMENT) = .Command
  194.                 vServiceData(giDATA_PRESENT_ELEMENT) = .DataPresent
  195.                 If .DataPresent Then
  196.                     'Check what data type vService return is
  197.                     'in order to determine how to handle it
  198.                     Select Case VarType(.Data)
  199.                         Case vbEmpty, vbNull
  200.                             vServiceData(giSERVICE_DATA_ELEMENT) = Null
  201.                         Case vbObject, vbError, vbDataObject
  202.                             Set vServiceData(giSERVICE_DATA_ELEMENT) = .Data
  203.                         Case Else
  204.                             vServiceData(giSERVICE_DATA_ELEMENT) = .Data
  205.                     End Select
  206.                 End If
  207.             End With
  208.             Set oService = Nothing
  209.             
  210.             QueueDelegator_GetServiceRequest = vServiceData()
  211.             On Error GoTo QueueDelegator_GetServiceRequestError
  212.         Else
  213. NoServiceToReturn:
  214.             'If there is not pending Service request
  215.             'mark Busy equal false in the clsWorker class
  216.             'object that has a reference to the Worker
  217.             'calling the GetServiceRequest method.
  218.             If gbShow Then frmQueueMgr.lblQueue = 0
  219.             oWork.Busy = False
  220.             QueueDelegator_GetServiceRequest = Null
  221.         End If
  222.     End If
  223.     
  224.     'Display stats
  225.     If gbShow Then frmQueueMgr.lblQueue = lCount
  226.     If lCount > glPeakQueueSize Then
  227.         glPeakQueueSize = lCount
  228.         If gbShow Then frmQueueMgr.lblPeak = glPeakQueueSize
  229.     End If
  230.     
  231.     gbBusyGetServiceRequest = False
  232.     If gbStopTest And Not gbBusyAdding And Not gbBusyGetServiceResults Then StopQueue
  233.     Exit Function
  234. QueueDelegator_GetServiceRequestError:
  235.     LogError Err, 0
  236.     Err.Raise Err.Number, Err.Source, Err.Description
  237.     Exit Function
  238.  
  239. End Function
  240.  
  241. Private Function QueueDelegator_GetServiceResults() As Variant
  242.     '-------------------------------------------------------------------------
  243.     'Purpose:   This method is provided for the Expediter to call and retrieve
  244.     '           all completed Service Request results and there respective
  245.     '           callback objects
  246.     'Return:    Is a variant array with Service Results if the QueueMgr
  247.     '           has completed Service Results for it to satify.  Otherwise, a Null
  248.     '           is returned.  The Service ID, the Data to be returned, the Callback
  249.     '           object, and the Error description string are returned with in
  250.     '           The variant array for each Service Result returned.  The array
  251.     '           will have two dimensions.  The first dimension will have an
  252.     '           index to represent each data element of the Service Results --
  253.     '           see modAEConstants for the index constants--the second dimension
  254.     '           will have an index for each Service Result
  255.     'Effects:
  256.     '   [gbBusyGetServiceResults]
  257.     '           Is true during this procedure
  258.     '   [gcQueue]
  259.     '           Any clsService object with its Status property equaling
  260.     '           giHAVE_SERVICE_RESULTS will be removed.
  261.     '-------------------------------------------------------------------------
  262.     Dim vaResults As Variant        'Variant array to be returned to Expediter
  263.     Dim lResultCount As Long        'Count of results added to Result array
  264.     Dim oService As clsService      'Object for For...Each loop
  265.     Dim lUB As Long                 'Upper Bound of the 2nd dimension of vaResults
  266.     
  267.     gbBusyGetServiceResults = True
  268.     
  269.     'Check the gbHaveServiceResults flag so we don't check ever
  270.     'clsService object in gcQueue if we know that there are no
  271.     'ready Service Results
  272.     If gbHaveServiceResults Then
  273.         gbHaveServiceResults = False
  274.         
  275.         ReDim vaResults(giRESULT_DIMENSION_ONE, giRESULT_ARRAY_REDIM_CHUNK_SIZE)
  276.         lUB = giRESULT_ARRAY_REDIM_CHUNK_SIZE
  277.         
  278.         'Check if any clsService objects in gcQueue are ready to be returned
  279.         For Each oService In gcQueue
  280.             With oService
  281.                 If oService.Status = giHAVE_SERVICE_RESULTS Then
  282.                     'Put the data of this clsService object in
  283.                     'the array then remove the object from the collection
  284.                     'See if vaResults needs redimensioned
  285.                     If lResultCount > lUB Then
  286.                         lUB = lUB + giRESULT_ARRAY_REDIM_CHUNK_SIZE
  287.                         ReDim Preserve vaResults(giRESULT_DIMENSION_ONE, lUB)
  288.                     End If
  289.                     
  290.                     'Get values
  291.                     vaResults(giRESULT_ID_ELEMENT, lResultCount) = .ID
  292.                     vaResults(giRESULT_CALLBACK_TYPE_ELEMENT, lResultCount) = .CallBackMode
  293.                     Select Case .CallBackMode
  294.                         Case giUSE_PASSED_CALLBACK, giUSE_DEFAULT_CALLBACK
  295.                             Set vaResults(giRESULT_CALLBACK_ELEMENT, lResultCount) = .CallBack
  296.                         Case giRETURN_BY_SYNC_EVENT
  297.                             Set vaResults(giRESULT_CALLBACK_ELEMENT, lResultCount) = .EventObject
  298.                     End Select
  299.                     vaResults(giRESULT_ERROR_ELEMENT, lResultCount) = .ReturnError
  300.                     'Check what data type .ReturnData is
  301.                     'in order to determine how to handle it
  302.                     Select Case VarType(.ReturnData)
  303.                         Case vbEmpty, vbNull
  304.                             vaResults(giRESULT_DATA_ELEMENT, lResultCount) = Null
  305.                         Case vbObject, vbError, vbDataObject
  306.                             Set vaResults(giRESULT_DATA_ELEMENT, lResultCount) = .ReturnData
  307.                         Case Else
  308.                             vaResults(giRESULT_DATA_ELEMENT, lResultCount) = .ReturnData
  309.                     End Select
  310.                     
  311.                     'Remove the current clsService object from gcQueue
  312.                     gcQueue.Remove CStr(.ID)
  313.                     lResultCount = lResultCount + 1
  314.                     'exit the loop if the array has reached the max size
  315.                     'the rest of the results will be returned on another call
  316.                     If lResultCount - 1 = giRESULT_ARRAY_MAX_SIZE Then Exit For
  317.                 End If
  318.             End With
  319.         Next
  320.         
  321.         'Check if any results were put in the array
  322.         'If they were redimension the array to trim of indexes that do not have
  323.         'data in them and return the array as the result of this function
  324.         'If no results were put in the array return null
  325.         If lResultCount >= 1 Then
  326.             LogEvent giGETRESULTS_RECEIVED_RETURNED_RESULTS, 0
  327.             ReDim Preserve vaResults(giRESULT_DIMENSION_ONE, lResultCount - 1)
  328.             QueueDelegator_GetServiceResults = vaResults
  329.         Else
  330.             QueueDelegator_GetServiceResults = Null
  331.         End If
  332.     End If
  333.     
  334.     'Display stats
  335.     If gbShow Then frmQueueMgr.lblQueue = gcQueue.Count
  336.     
  337.     If gbStopTest And Not gbBusyGetServiceRequest And Not gbBusyAdding Then StopQueue
  338.     gbBusyGetServiceResults = False
  339. End Function
  340.